(* Implementare controllo per evitare nomi di funzione duplicati *)

(* dichiarazioni di tipo per Store *)
type mval = int;;

type store = Mem of (loc -> mval) * int;;

(* Store *)
let emptystore = fun () -> Mem ((fun x -> 0), 0x1FFFF);;

let applystore (Mem (sigma, dim)) l =
	if 0 <= l && l < dim then sigma l
	else raise (AddressOutOfBounds l)
;;

let update (Mem (sigma, dim)) l m =
	if 0 <= l && l < dim then Mem ((fun l' -> if l'= l then m else sigma l'), dim)
	else raise (AddressOutOfBounds l);;

let rec get_env env_list f_name = match env_list with
	| hd::tail -> if  (fst(hd)=f_name) then snd(hd) else get_env tail f_name 
	| _ -> raise (DEBUG ("ma non doveva restituire un ambiente vuoto by Stefano"));;

let rec sem_exp e (r, l, s, env_list) = match e with
		N n -> (Int n, s)
	| B b -> (Bool b, s)
	| Fun f -> (match f with
				| CBV(name, p_value) ->
						(match applyenv r name with
								DFunc(TValue, in_t, out_t, p_name, Program(d, block), Return (e)) ->		
									let static_env = get_env env_list name in(
												let (static_env', l', s') =
												( bind static_env p_name (DVar (in_t, l)), l + 1, (update s l (match fst(sem_exp p_value (r, l, s,[])) with
													| Bool b -> b
													| Int n -> n
												) ) ) in(																																			
															let (r', l', s') = sem_dec d (static_env', l', s') in(
											 				(sem_exp e (r', l', (sem_block block (r', l', s',env_list)),env_list))
															)))
					| Unbound -> raise (UnboundIde name)
					| _ -> raise (TypeMismatch ("You are using a function as something else"))
						)
				| CBR(name, ref) ->
						(match applyenv r name with
								DFunc(TRef, in_t, out_t, p_name, Program(d, block), Return (e)) ->
									let static_env = get_env env_list name in(											
														let (r', l', s') = sem_dec d ((bind static_env p_name (applyenv r ref)), l, s)
														in (sem_exp e (r', l', (sem_block block (r', l', s',env_list)),env_list)
														))
							| Unbound -> raise (UnboundIde name)
							| _ -> raise (TypeMismatch ("You are using a function as something else"))
						)
			)
	| Val x ->
			(match applyenv r x with
					DVar (DInt, loc) -> (Int (applystore s loc), s)
				| DVar (DBool, loc) -> (Bool (applystore s loc), s)
				| DConst (t, c) -> (c, s)
				| DArray (_, _, loc) -> raise (TypeMismatch (
									"You have tried to access array" ^ x ^ " as a variable"))
				| _ -> raise (UnboundIde x)
			)
	| ArrayVal (x, e') -> (match applyenv r x with
					DArray (DInt, dim, loc) ->
						(
							let index = (match fst(sem_exp e' (r, l, s,env_list)) with
									| Int n -> n
									| _ ->
											raise (TypeMismatch ("You are trying to use an int value for a bool value"))
								)
							in
							(
								if ( index >= 0 && index < dim )
								then (Int (applystore s (loc + index)), s)
								else raise (IndexOutOfBounds("you cannnot acces to this index, because exceeds the array dimension"))
							))
				
				| DArray (DBool, dim, loc) -> (
							let index = (match fst(sem_exp e' (r, l, s,env_list)) with
									| Int n -> n
									| _ -> raise (TypeMismatch ("You are trying to use an int value for a bool value"))
								)
							in
							(
								if ( index >= 0 && index < dim )
								then (Bool (applystore s (loc + index)), s)
								else raise (IndexOutOfBounds("you cannnot acces to this index, because exceeds the array dimension"))
							))
				
				| DVar (_, loc) -> raise (TypeMismatch ("You have tried to access variable " ^ x ^ " as an array"))
				| DConst (t, c) -> raise (TypeMismatch (
									"You have tried to access constant " ^ x ^ " as an array"))
				| _ -> raise (UnboundIde x)
			)
	
	| EAdd (e1, e2) -> let (v1, s') = sem_exp e1 (r, l, s,env_list)	in (
				let (v2, s'') = sem_exp e2 (r, l, s',env_list) in(
					match (v1, v2) with
					| (Int n1, Int n2) -> (Int (n1 + n2), s'')
					| (_, _) -> raise (TypeMismatch ("You are trying to use an int value for a bool value"))
				))
	
	| ESub (e1, e2) -> let (v1, s') = sem_exp e1 (r, l, s,env_list)	in (
				let (v2, s'') = sem_exp e2 (r, l, s',env_list) in(
					match (v1, v2) with
					| (Int n1, Int n2) -> ( Int (n1 - n2), s'')
					| (_, _) -> raise (TypeMismatch ("You are trying to use an int value for a bool value"))
				))
	| EMul (e1, e2) -> let (v1, s') = sem_exp e1 (r, l, s,env_list)	in (
				let (v2, s'') = sem_exp e2 (r, l, s',env_list) in(
					match (v1, v2) with
					| (Int n1, Int n2) -> (Int (n1 * n2), s'')
					| (_, _) -> raise (TypeMismatch ("You are trying to use an int value for a bool value"))
				))
	
	| EMax (e1, e2) ->	let (v1, s') = sem_exp e1 (r, l, s,env_list)	in (
				let (v2, s'') = sem_exp e2 (r, l, s',env_list) in(
					match (v1, v2) with
					| (Int n1, Int n2) -> (Int ( if n1 >= n2 then n1 else n2 ), s'')
					| (_, _) -> raise (TypeMismatch ("You are trying to use an int value for a bool value"))
				))
	| Eq (e1, e2) -> let (v1, s') = sem_exp e1 (r, l, s,env_list)	in (
				let (v2, s'') = sem_exp e2 (r, l, s',env_list) in(
					match (v1, v2) with
					| (Int n1, Int n2) -> (Bool ( if n1 = n2 then 1 else 0 ), s'')
					| (_, _) -> raise (TypeMismatch ("You are trying to use an int value for a bool value"))
				))
	| Lt (e1, e2) -> let (v1, s') = sem_exp e1 (r, l, s,env_list)	in (
				let (v2, s'') = sem_exp e2 (r, l, s',env_list) in(
					match (v1, v2) with
					| (Int n1, Int n2) -> ( (Bool ( if n1 <= n2 then 1 else 0 )), s'' )
					| (_, _) -> raise (TypeMismatch ("You are trying to use an int value for a bool value"))
				))
	| Not e' -> let (v1, s') = sem_exp e' (r, l, s,env_list)	in(
				match v1 with
				| Bool n1 -> (Bool ( if n1 = 0 then 1 else 0 ), s')
				| _ -> raise (TypeMismatch ("You are trying to use an int value for a bool value"))
			)
	| And (e1, e2) -> let (v1, s') = sem_exp e1 (r, l, s,env_list)	in (
				let (v2, s'') = sem_exp e2 (r, l, s',env_list) in(
					match (v1, v2) with
					| (Bool b1, Bool b2) -> (Bool( if b1 = 0 || b2 = 0 then 0 else 1 ), s'')
					| (_, _) -> raise (TypeMismatch ("You are trying to use an int value for a bool value"))
				))
	| Or (e1, e2) -> let (v1, s') = sem_exp e1 (r, l, s,env_list)	in (
				let (v2, s'') = sem_exp e2 (r, l, s',env_list) in(
					match (v1, v2) with
					| (Bool b1, Bool b2) -> (Bool( if b1 = 0 && b2 = 0 then 0 else 1 ), s'')
					| (_, _) -> raise (TypeMismatch ("You are trying to use an int value for a bool value"))
				))
and
(* Valutazione delle dichiarazioni *)
sem_dec d (r, l, s) = match d with
		Empty -> (r, l, s)
	| Const(t, x, v) -> (match applyenv r x with
				| DFunc (_,_, _, _ , _, _) -> raise (DuplicateFunctionIdentifier ("The identifier"^x^"is already bounded to a function"))
				| _ -> (bind r x (DConst (t, v)), l, s)
			)
	| Var (t, x) -> (match applyenv r x with
				| DFunc (_,_, _, _ , _, _) -> raise (DuplicateFunctionIdentifier ("The identifier"^x^"is already bounded to a function"))
				| _ -> (bind r x (DVar (t, l)), l + 1, s))
	| Init (t, x, e) -> (match applyenv r x with
				| DFunc (_,_, _, _ , _, _) -> raise (DuplicateFunctionIdentifier ("The identifier"^x^"is already bounded to a function"))
				| _ -> ( bind r x (DVar (t, l)), l + 1, (update s l (match fst(sem_exp e (r, l, s,[])) with
										| Bool b -> b
										| Int n -> n
									) ) )
			)
	| Array (t, x, v) -> (match applyenv r x with
				| DFunc (_,_, _, _ , _, _) -> raise (DuplicateFunctionIdentifier ("The identifier"^x^"is already bounded to a function"))
				| _ -> if (v > 0) then (bind r x ( DArray (t, v, (l)) ), l + v, s)
						else raise (BadArrayDeclaration("You cannot initialize an array with dimension less than 1 - ", v))
			)
	| Function (in_t, name, tcall, out_t, param_name, body, ret) ->
			(match applyenv r name with
				| Unbound ->  (bind r name (DFunc(tcall, in_t, out_t, param_name, body, ret)) , l, s)
				| _ -> raise ( DuplicateFunctionIdentifier ("The identifier"^name^"is already bounded"))
			)
	| Dseq(d1, d2) -> sem_dec d2 (sem_dec d1 (r, l, s))

and
(* Valutazione dei comandi *)
sem_com c (rho, l, sigma,env_list) = match c with
		Skip -> sigma
	| AssignVar(x, e) -> (match applyenv rho x with
					DVar (t, loc) -> let (v, sigma') = sem_exp e (rho, l, sigma,env_list) in update sigma' loc ((match v with
									| Bool b -> b
									| Int n -> n
								))
				| _ -> raise (TypeMismatch ("You have tried to assign to non-variable" ^ x)))
	| AssignArray(x, e, e') -> (match applyenv rho x with
					DArray (t, dim, loc) -> let (index', sigma') = sem_exp e (rho, l, sigma,env_list) in(
							let index = (match index' with
									| Int n -> n
									| _ -> raise(TypeMismatch ("Index must be Int" ^ x))
								) in (
								if ( index >= 0 && index < dim )
								then
									let (v, sigma'') = sem_exp e' (rho, l, sigma',env_list) in(
										update sigma'' (loc + index) ((match v with
													| Bool b -> b
													| Int n -> n
												))
									)
								else raise (IndexOutOfBounds "You exceeded the boundaries of the array") )
						)
				| _ -> raise (TypeMismatch ("You have tried to assign to non-array" ^ x)))
	| Exchange(x, e1, e2) -> (match applyenv rho x with
				| DArray (t, dim, loc) ->
						let (v1, sigma') = sem_exp e1 (rho, l, sigma,env_list) in (
							let (v2, sigma'') = sem_exp e2 (rho, l, sigma',env_list) in(
								let (i, j) = ( (
											match v1 with
											| Int n -> n
											| _ -> raise(TypeMismatch ("Index must be Int" ^ x))
										),
										(
											match v2 with
											| Int n -> n
											| _ -> raise(TypeMismatch ("Index must be Int" ^ x))
										)
									)
								in
								if ( i >= 0 && i < dim && j >= 0 && j < dim )
								then (
									let (vi', sigma''') = sem_exp (ArrayVal(x, (N i))) (rho, l, sigma'',env_list) in (
										let (vj', sigma'''') = sem_exp (ArrayVal(x, (N j))) (rho, l, sigma''',env_list) in(
											let (vi, vj) = (
													(match vi' with
														| Bool b -> b
														| Int n -> n
													),
													(match vj' with
														| Bool b -> b
														| Int n -> n
													)
												)
											in
											(
												sem_com (Cseq(AssignArray(x, (N i), (N vj)), AssignArray(x, (N j), (N vi)))) (rho, l, sigma'''',env_list)
											)
										))) else raise (IndexOutOfBounds "You exceeded the boundaries of the array")
							)
						)
				| _ -> raise (TypeMismatch ("You have tried to assign to non-array" ^ x)))
	| Cseq(c1, c2) ->
			sem_com c2 (rho, l, (sem_com c1 (rho, l, sigma,env_list)) ,env_list)
	| If(e, c1, c2) ->
			let (v, sigma') = sem_exp e (rho, l, sigma, env_list) in(
				if v = Bool 0
				then sem_com c2 (rho, l, sigma',env_list)
				else sem_com c1 (rho, l, sigma',env_list)
			)
	| While(e, c') ->
			let (v, sigma') = sem_exp e (rho, l, sigma,env_list) in (
				if v = Bool 0
				then sigma'
				else sem_com c (rho, l, sem_com c' (rho, l, sigma',env_list),env_list)
			)
and

sem_block block (rho, l, s,env_list) = match block with
	| BlockSeq(b1, b2) -> sem_block b2 (rho, l, sem_block b1 (rho, l, s,env_list),env_list)
	| DecBlock (dec, b1) -> let (rho', l', s') = sem_dec dec (rho, l, s) in
			sem_block b1 (rho', l', s',env_list)
	| Com (com) -> sem_com com (rho, l, s, env_list)
;;

(* Valutazione programmi *)
let sem_prog (Program (d, b)) =
	let (rho,l,env_list, fun_list) = close_dec d (emptyenv(), 0,[],[]) in(
		let (rho',l',env_list') = close_block b (rho,l,env_list) in(
			let (rho, l, s) = sem_dec d (emptyenv(), 0, emptystore())
				in( sem_block b (rho, l, s,env_list')
				)))
;;

(* funzioni per il debug *)
let rec range a b =
	if a > b then []
	else a:: (range (a + 1) b);;

let rec ide = function
		Empty -> []
	| Const (t, x, v) -> [x]
	| Var (t, x) -> [x]
	| Init (t, x, e) -> [x]
	| Array (t, x, v) -> [x]
	| Function ( _, x,_, _, _, _, _) -> [x]
	| Dseq (d1, d2) -> (ide d1) @ (ide d2)
;;

let int_dump (Program (d, b)) =
	let (rho,l,env_list, fun_list) = close_dec d (emptyenv(), 0,[],[]) in(
		let (rho',l',env_list') = close_block b (rho,l,env_list) in(
			let (r, l, s) = sem_dec d (emptyenv(), 0, emptystore()) in( 
				let s_final = ( sem_block b (r, l, s,env_list') ) in (
					  List.map (fun x -> (x, applyenv r x)) (ide d),
						List.map (applystore s_final) (range 0 (l - 1))
						))))
;;